﻿{******************************************************************************}
{                                                                              }
{                               UNIT MultiLang                                 }
{                                                                              }
{  В этом модуле реализована поддержка мультиязычного интерфейса приложения.   }
{  This unit contains implementation of multilingual interface support.        }
{                                                                              }
{                       Copyright © 2010 by Xcentric                           }
{                                                                              }
{http://code.google.com/p/powered-by-delphi/                                   }
{******************************************************************************}

{

  ИСТОРИЯ ВЕРСИЙ / VERSION HISTORY:

  (1.0 | XX.XX.2010)
    Первый релиз модуля.
    First unit release.

}

unit MultiLang;

{$WARN SYMBOL_PLATFORM OFF}

interface

uses
  Windows, Classes, SysUtils, Generics.Collections, XMLDoc, XMLIntf, XMLDOM,
  RTTI, TypInfo, Forms, Dialogs,
  SysUtilsEx;
{ TODO : убрать используемый для отладки unit Dialogs. }

type

  ///  Чуть обработанный напильником потомок дженерика TObjectList<T>:
  TMyObjectList<T : class, constructor> = class sealed (TObjectList<T>)
    public
      constructor Create;
      destructor Destroy; override;

      function Add : T;
  end;

//------------------------------------------------------------------------------

  ///  Версия формата языкового источника:
  TLangSourceFormatVersion = Single;

  ///  Версия целевой мультиязычной программы:
  TTargetProgramVersion = record
    Major, Minor, Release, Build : Integer;
    Text : String;
  end;

  ///  Информация о формате языкового источника:
  TLangSourceFormatInfo = record
    SourceFormatVersion : TLangSourceFormatVersion;
    TargetProgramName : String;
    TargetProgramVersion : TTargetProgramVersion;
    Comments : String;
  end;

//------------------------------------------------------------------------------

  ///  Перевод единичного свойства объекта:
  TPropertyTranslation = class sealed
    public
      PropertyName, PropertyTranslation : String;
  end;

  ///  Базовый абстрактный класс для хранения переводов всех свойств единичного объекта:
  TObjectTranslation = class abstract
    strict private
      FProperties : TMyObjectList<TPropertyTranslation>;
    public
      constructor Create;
      destructor Destroy; override;

      property Properties : TMyObjectList<TPropertyTranslation> read FProperties;
  end;

  ///  Класс для хранения переводов всех свойств единичного компонента:
  TComponentTranslation = class (TObjectTranslation)
    strict private
      FName : String;
      FTag : Integer;
    public
      property Name : String read FName write FName;
      property Tag : Integer read FTag write FTag;
  end;

  ///  Класс для хранения переводов всех свойств единичного RTTI-объекта:
  TRTTIObjectTranslation = class (TObjectTranslation)
    strict private
      FRTTIObjectID : Integer;
    public
      property RTTIObjectID : Integer read FRTTIObjectID write FRTTIObjectID;
  end;

  ///  Класс для определения необходимости перевода вложенных объектов при помощи словаря:
  TDictionaryTranslation = class (TObjectTranslation);

  ///  Единичный элемент словаря:
  TDictionaryItem = class sealed
    public
      OriginalText, TranslatedText : String;
  end;

  ///  Информация о языковом переводе:
  TTranslationInfo = record
    Language, Copyright, Comments : String;
  end;

  ///  Исключение: строка с указанным StringID не найдена
  EStringNotFound = class (Exception);

  ///  Языковой перевод:
  TTranslation = class
    strict private
      FInfo : TTranslationInfo;
      FComponents  : TMyObjectList<TComponentTranslation>;
      FRTTIObjects : TMyObjectList<TRTTIObjectTranslation>;
      FDictionary  : TMyObjectList<TDictionaryItem>;
      FStringTable : TDictionary<Integer, String>;
    public
      constructor Create;
      destructor Destroy; override;

      procedure AddObjectTranslation(const AObject : TPersistent;
                                     const ExcludeProperties : TStrings = nil);
      function  GetStringByID(const StringID : Integer) : String;
      function  GetStringID(const S : String) : Integer;

      property Info : TTranslationInfo read FInfo write FInfo;
      property Components : TMyObjectList<TComponentTranslation> read FComponents;
      property RTTIObjects : TMyObjectList<TRTTIObjectTranslation> read FRTTIObjects;
      property Dictionary : TMyObjectList<TDictionaryItem> read FDictionary;
      property StringTable : TDictionary<Integer, String> read FStringTable;
  end;

//------------------------------------------------------------------------------

  ///  Исключение: языковой источник невалиден
  ELangSourceNotValid = class (Exception);

  ///  Исключение: языковой источник не совместим с целевой программой или модулем
  ELangSourceNotCompatible = class (Exception);

  ///  Абстрактный класс для чтения/парсинга языкового источника и записи в него:
  TLangSource = class abstract (TComponent)
    strict private
      FSourceFormatInfo : TLangSourceFormatInfo;
      FTranslations : TMyObjectList<TTranslation>;
    protected
      FXML : TXMLDocument;

      procedure FormatData; virtual; final; // и баста! потомки должны быть уверены что сохраняют в валидном формате
      procedure InitXML; virtual;
      procedure Parse;
      procedure ParseComponentTranslation(Node : IXMLNode; const Translation : TTranslation);
      procedure ParseDictionary(Node : IXMLNode; const Translation : TTranslation);
      procedure ParseFormatInfo;
      procedure ParsePropertyTranslation(const Destination : TObjectTranslation; const APropertyName, APropertyTranslation : String); inline;
      procedure ParseRTTIObjectTranslation(Node : IXMLNode; const Translation : TTranslation);
      procedure ParseStringTable(Node : IXMLNode; const Translation : TTranslation);
      procedure ParseTranslationInfo(Node : IXMLNode; const Translation : TTranslation);
      procedure XML_Panic;
      procedure WriteData; virtual; abstract;
    public
      constructor Create(AutoLoad : Boolean = True); reintroduce;
      destructor Destroy; override;

      procedure LoadFromSource; virtual; abstract;
      procedure SaveToSource;

      property SourceFormatInfo : TLangSourceFormatInfo read FSourceFormatInfo write FSourceFormatInfo;
      property Translations : TMyObjectList<TTranslation> read FTranslations;
  end;

  ///  Языковой источник в виде файла:
  TLanguageFile = class (TLangSource)
    strict private
      FFileName : String;
    protected
      function  GetFileName : String;
      procedure InitXML; override;
      procedure WriteData; override;
    public
      constructor Create(const FileName : String; AutoLoad : Boolean = True);

      procedure LoadFromSource; override;

      property FileName : String read GetFileName;
  end;

  ///  Языковой источник в виде ресурса exe/dll файла:
  TLanguageResource = class (TLangSource)
    private
      FMS : TMemoryStream;
      FFileName, FResourceID : String;
    protected
      procedure WriteData; override;
    public
      constructor Create(const FileName, ResourceID : String);
      destructor Destroy; override;

      procedure LoadFromSource; override;

      property FileName : String read FFileName;
      property ResourceID : String read FResourceID;
  end;

//------------------------------------------------------------------------------

  ///  Исключение: запрашиваемый язык не найден
  ELanguageNotFound = class (Exception);

  ///  Класс для перевода свойств объектов:
  TTranslator = class
    strict private
      FCurrentTranslation : TTranslation;
      FLangSource : TLangSource;
      FOwnsSource : Boolean;
    protected
      function  GetCurrentLanguage : String;
      procedure SetCurrentLanguage(Value : String);
      function  TranslateProperty(const AObject : TObject; const Prop : TRTTIProperty; const Translation : TObjectTranslation; TranslateWithDict : Boolean) : String;
      procedure Translate(const AObject : TPersistent; const Translation : TObjectTranslation;
                          TranslateNestedRTTI : Boolean); overload;
    public
      constructor Create(LangSource : TLangSource; OwnsSource : Boolean = True);
      destructor Destroy; override;

      function  GetStringByID(const StringID : Integer) : String;
      procedure Translate(const Component : TComponent; TranslateNestedRTTI : Boolean = True); overload;
      procedure Translate(const RTTIObject : TPersistent; const RTTIObjectID : Integer;
                          TranslateNestedRTTI : Boolean = False); overload;
      function  TranslateWithDictionary(const OriginalText : String) : String;

      property CurrentLanguage : String read GetCurrentLanguage write SetCurrentLanguage;
  end;

  ///  Класс автопереводчика не работает в DLL:
  EWorkInDLLNotSupportedByClass = class (Exception);

  ///  Класс автоматического перевода всех компонентов приложения:
  TAutoAppTranslator = class sealed (TTranslator)
    public
      function TranslateApp(const Language : String) : Boolean; overload;
      function TranslateApp(const LocaleID : Cardinal) : Boolean; overload;
      function TranslateApp : Boolean; overload;
  end;

//------------------------------------------------------------------------------

resourcestring

  // Exception messages:
  STR_STRING_NOT_FOUND = 'A string with StringID %d wasn''t found in the string table.';
  STR_INVALID_LANGSOURCE = 'The specified language source has invalid format.';
  STR_LANGSOURCE_NOT_COMPATIBLE = 'The specified language source is incompatible with current version of a program or MultiLang unit.';
  STR_INVALID_LANGSOURCE_ARG = 'The language source is not assigned.';

implementation

{$REGION 'TMyObjectList<T>'}
//---------------------------{ TMyObjectList<T> }-------------------------------

constructor TMyObjectList<T>.Create;
begin
  // Создаём коллекцию таким образом, чтобы все добавляемые объекты принадлежали ей:
  Inherited Create(True);
end;

destructor TMyObjectList<T>.Destroy;
begin
  // Заставляем коллекцию уничтожать принадлежащие ей объекты:
  While (Count > 0) do Self.Delete(0);
  Inherited Destroy;
end;

function TMyObjectList<T>.Add : T;
begin
  // Создаём и добавляем объект,
  // работает только для классов с беспараметровыми конструкторами:
  Result := T.Create;
  Inherited Add(Result);
end;
{$ENDREGION}

{$REGION 'TObjectTranslation'}
//-------------------------{ TObjectTranslation<T> }----------------------------

constructor TObjectTranslation.Create;
begin
  Inherited;
  FProperties := TMyObjectList<TPropertyTranslation>.Create;
end;

destructor TObjectTranslation.Destroy;
begin
  FreeAndNil(FProperties);
  Inherited;
end;
{$ENDREGION}

{$REGION 'TTranslation'}
//-----------------------------{ TTranslation }---------------------------------

constructor TTranslation.Create;
begin
  Inherited;
  FComponents  := TMyObjectList<TComponentTranslation>.Create;
  FRTTIObjects := TMyObjectList<TRTTIObjectTranslation>.Create;
  FDictionary  := TMyObjectList<TDictionaryItem>.Create;
  FStringTable := TDictionary<Integer, String>.Create;
end;

destructor TTranslation.Destroy;
begin
  FreeAndNil(FComponents);
  FreeAndNil(FRTTIObjects);
  FreeAndNil(FDictionary);
  FreeAndNil(FStringTable);
  Inherited;
end;

///  Добавление объектного перевода на основе переданного объекта:
procedure TTranslation.AddObjectTranslation(const AObject : TPersistent;
                                            const ExcludeProperties : TStrings = nil);
begin
  Assert(AObject <> nil, 'AObject must be assigned!');
{ TODO :
Автоматически добавлять перевод для указанного объекта,
записывая в этот перевод все свойства объекта, кроме тех, которые были перечислены
в параметре ExcludeProperties (каждое свойство - отдельный Item).
Данный метод будет самостоятельно определять тип объекта и добавлять его перевод
в соответствующую коллекцию (TTranslation.Components или TTranslation.RTTIObjects).
Можно ещё добавить пропуск свойства TComponent.Name, хотя это несущественно, т.к.
при чтении языкового источника и переводе компонента оно пропускается автоматически.
И предпоследнее: если ExcludeProperties = nil, то это значит, что никакие свойства не будут
исключаться из чтения и записи в объектный перевод.
И последнее: для вложенных объектов переводы создаваться и записываться не будут. }
end;

///  Поиск строки по её идентификатору в таблице строк:
function TTranslation.GetStringByID(const StringID : Integer) : String;
begin
  Result := FStringTable.Items[StringID];
end;

///  Поиск идентификатора строки в таблице строк:
function TTranslation.GetStringID(const S : String) : Integer;
begin
  Result := -1;
  With FStringTable.GetEnumerator do
  begin
    While MoveNext do
    begin
      If AnsiSameText(Current.Value, S) Then
      begin
        Result := Current.Key; // found!
        Break;
      end;
    end;
  end;
end;
{$ENDREGION}

{$REGION 'TLangSource'}
//------------------------------{ TLangSource }---------------------------------

constructor TLangSource.Create(AutoLoad : Boolean = True);
begin
  Inherited Create(nil);
  FTranslations := TMyObjectList<TTranslation>.Create;
  InitXML;  // вдруг потомки в loadfromsource забудут это сделать?
  If AutoLoad Then LoadFromSource;
end;

destructor TLangSource.Destroy;
begin
  FreeAndNil(FTranslations);
  FreeAndNil(FXML);
  Inherited;
end;

///  Формирование XML-данных:
procedure TLangSource.FormatData;
  var
    i, j, z : Integer;
begin
  // root:
  With FXML.AddChild('LanguageSource') do
  begin

    // writing source format info:
    With AddChild('SourceFormatInfo'), FSourceFormatInfo do
    begin
      // format version:
      ChildValues['SourceFormatVersion'] := SourceFormatVersion;

      // target program name:
      ChildValues['TargetProgramName'] := TargetProgramName;

      With AddChild('TargetProgramVersion'), TargetProgramVersion do
      begin
        Attributes['major']   := Major;
        Attributes['minor']   := Minor;
        Attributes['release'] := Release;
        Attributes['build']   := Build;
        // Text:
        ParentNode.ChildValues['TargetProgramVersion'] := Text;
      end;

      // comments:
      AddChild('Comments').ChildNodes.Add(FXML.CreateNode(Comments, ntCDATA));
    end;

    // writing translations:
    With AddChild('Translations') do
    begin
      For i := 0 To FTranslations.Count - 1 do
      begin
        // single translation:
        With AddChild('Translation'), FTranslations.Items[i] do
        begin

          // translation info:
          With AddChild('TranslationInfo'), FTranslations.Items[i].Info do
          begin
            ChildValues['Language']  := Language;
            ChildValues['Copyright'] := Copyright;
            AddChild('Comments').ChildNodes.Add(FXML.CreateNode(Comments, ntCDATA));
          end;

          // component translations:
          With AddChild('Components') do
          begin
            For j := 0 To Components.Count - 1 do
            begin
              // single component:
              With AddChild(Components.Items[j].Name) do
              begin
                Attributes['tag'] := Components.Items[j].Tag;

                // properties:
                With Components.Items[j].Properties do
                begin
                  For z := 0 To Count - 1 do
                    ChildValues[Items[z].PropertyName] := GetStringID(Items[z].PropertyTranslation);
                end;{properties}
              end;{single component}
            end;{all components}
          end;{components node}

          // rtti objects translations:
          With AddChild('RTTIEnabledObjects') do
          begin
            For j := 0 To RTTIObjects.Count - 1 do
            begin
              // single component:
              With AddChild('Object') do
              begin
                Attributes['id'] := RTTIObjects.Items[j].RTTIObjectID;

                // properties:
                With RTTIObjects.Items[j].Properties do
                begin
                  For z := 0 To Count - 1 do
                    ChildValues[Items[z].PropertyName] := GetStringID(Items[z].PropertyTranslation);
                end;{properties}
              end;{single rtti object}
            end;{all rtti objects}
          end;{RTTIEnabledObjects node}

          // filling dictionary:
          With AddChild('Dictionary') do
          begin
            For j := 0 To Dictionary.Count - 1 do
            begin
              With AddChild('item') do
              begin
                ChildNodes.Add(FXML.CreateNode(Dictionary.Items[j].OriginalText, ntCDATA));
                Attributes['stringid'] := GetStringID(Dictionary.Items[j].TranslatedText);
              end;
            end;
          end;

          // filling stringtable:
          With AddChild('StringTable'), StringTable.GetEnumerator do
          begin
            While MoveNext do
            begin
              With AddChild('string') do
              begin
                Attributes['id'] := Current.Key;
                ChildNodes.Add(FXML.CreateNode(Current.Value, ntCDATA));
              end;
            end;
          end;

        end;{single translation}
      end;{all translations}
    end;{translations node}
  end;{root}
end;

///  Инициализация XML-документа:
procedure TLangSource.InitXML;
begin
  If Assigned(FXML) Then FXML.XML.Clear  // Это очистит свойство FileName
  Else
  begin
    FXML := TXMLDocument.Create(Self);
    With FXML do
    begin
      DOMVendor := GetDOMVendor('MSXML');
      Options := [doNodeAutoCreate, doNodeAutoIndent, doAttrNull];
      ParseOptions := [poPreserveWhiteSpace];
      NodeIndentStr := #9;  // Tab
    end;
  end;

  With FXML do
  begin
    Active := True;
    Version := '1.0';
    Encoding := 'UTF-8';
    StandAlone := 'yes';
//    XML.Text := XML.Text + sLineBreak;  // Это очистит свойство FileName
//    Active := True;
  end;
end;

{ TODO : full review of нижеследующей процедуры. }
///  Парсинг и валидация XML-документа языкового источника:
procedure TLangSource.Parse;
  var
    i, j : Integer;
    NewTranslation : TTranslation;
begin
  If FXML.IsEmptyDoc Then XML_Panic;

  Try
  	ParseFormatInfo;  // Обрабатываем информацию о формате языкового источника

    With FXML.DocumentElement.ChildNodes['Translations'] do
    begin
      For i := 0 To ChildNodes.Count - 1 do
      begin
        //If Not AnsiSameText(ChildNodes[i].NodeName, 'Translation') Then Continue;
        If (ChildNodes[i].NodeType <> ntElement) Then Continue;

        // i-ый <Translation>
        // В каждую такую итерацию должен быть создан один TTranslation:
        NewTranslation := FTranslations.Add;

        ParseTranslationInfo(ChildNodes[i], NewTranslation);  // Парсим инфу о переводе
        ParseStringTable(ChildNodes[i], NewTranslation);  // Парсим таблицу строк

        With ChildNodes['Components'] do
        begin
          For j := 0 To ChildNodes.Count - 1 do
          begin
            If (ChildNodes[i].NodeType <> ntElement) Then Continue;
            // j-ый <Component>
            ParseComponentTranslation(ChildNodes[j], NewTranslation);
          end;
        end;

        With ChildNodes['RTTIEnabledObjects'] do
        begin
          For j := 0 To ChildNodes.Count - 1 do
          begin
            If (ChildNodes[i].NodeType <> ntElement) Then Continue;
            // j-ый <Object>
            ParseRTTIObjectTranslation(ChildNodes[j], NewTranslation);
          end;
        end;

        ParseDictionary(ChildNodes[i], NewTranslation); // Парсим словарь
      end;
      // NewTranslation ни в коем случае не уничтожать !!!
    end;
  Except
    XML_Panic;
    //raise;  // скорее всего не вызывается
    Exit;
  End;
end;

procedure TLangSource.ParseComponentTranslation(Node : IXMLNode; const Translation : TTranslation);
  var
    i : Integer;
    CompTrans : TComponentTranslation;
begin
  { TODO : парсинг перевода компонентов. }
  CompTrans := Translation.Components.Add;
  CompTrans.Name := Node.NodeName;
  CompTrans.Tag  := Node.Attributes['tag'];

  // Properties:
  For i := 0 To Node.ChildNodes.Count - 1 do
  begin
    ParsePropertyTranslation(CompTrans, Node.ChildNodes[i].NodeName,
                             Node.ChildValues[Node.ChildNodes[i].NodeName]);
  end;
end;

procedure TLangSource.ParseDictionary(Node : IXMLNode; const Translation : TTranslation);
  var
    i : Integer;
begin
  { TODO : парсинг словаря. }
  // <Dictionary> node:
  With Node.ChildNodes['Dictionary'] do
  begin
    For i := 0 To ChildNodes.Count - 1 do
    begin
      With Translation.Dictionary.Add do
      begin
        If Not AnsiSameText(ChildNodes[i].NodeName, 'item') Then Continue;
        OriginalText   := ChildNodes[i].ChildNodes[0].Text;  // CDATA
        TranslatedText := Translation.GetStringByID(ChildNodes[i].Attributes['stringid']);
      end;
    end;
  end;
end;

procedure TLangSource.ParseFormatInfo;
begin
  { TODO : парсинг информации о формате языкового источника. }
  With FXML.DocumentElement.ChildNodes['SourceFormatInfo'] do
  begin
    With FSourceFormatInfo do
    begin
      SourceFormatVersion := ChildValues['SourceFormatVersion'];
      TargetProgramName := ChildNodes['TargetProgramName'].Text;
      With TargetProgramVersion do
      begin
        Major   := ChildNodes['TargetProgramVersion'].Attributes['major'];
        Minor   := ChildNodes['TargetProgramVersion'].Attributes['minor'];
        Release := ChildNodes['TargetProgramVersion'].Attributes['release'];
        Build   := ChildNodes['TargetProgramVersion'].Attributes['build'];
        Text    := ChildNodes['TargetProgramVersion'].Text;
      end;
      Comments := ChildNodes['Comments'].ChildNodes[0].Text;  // CDATA
    end;
  end;
end;

procedure TLangSource.ParsePropertyTranslation(const Destination : TObjectTranslation;
                                               const APropertyName,
                                               APropertyTranslation : String);
begin
  With Destination.Properties.Add do
  begin
    PropertyName := APropertyName;
    PropertyTranslation := APropertyTranslation;
  end;
  { TODO :
В класс TLangSource добавить метод
	protected ParsePropertyTranslation(Destination : TObjectTranslation; PropertyName, PropertyTranslation : String); inline;
который будет With Destination.Properties.Add добавлять PropertyName и PropertyTranslation.
Данный метод будет использоваться в циклах парсинга переводов свойств
компонентов (ParseComponentTranslation) и RTTI-объектов (ParseRTTIObjectTranslation),
что позволит избежать повторяющегося кода. }
end;

procedure TLangSource.ParseRTTIObjectTranslation(Node : IXMLNode; const Translation : TTranslation);
  var
    i : Integer;
    RTTIObjTrans : TRTTIObjectTranslation;
begin
  { TODO : парсинг перевода RTTI-объектов. }
  RTTIObjTrans := Translation.RTTIObjects.Add;
  RTTIObjTrans.RTTIObjectID := Node.Attributes['id'];

  // Properties:
  For i := 0 To Node.ChildNodes.Count - 1 do
  begin
    ParsePropertyTranslation(RTTIObjTrans, Node.ChildNodes[i].NodeName,
                             Node.ChildValues[Node.ChildNodes[i].NodeName]);
  end;
end;

procedure TLangSource.ParseStringTable(Node : IXMLNode; const Translation : TTranslation);
  var
    i : Integer;
begin
  { TODO : парсинг таблицы строк. }
  // <StringTable> node:
  With Node.ChildNodes['StringTable'] do
  begin
    For i := 0 To ChildNodes.Count - 1 do
    begin
      If (ChildNodes[i].NodeType <> ntElement) And
         (Not AnsiSameText(ChildNodes[i].NodeName, 'string')) Then Continue;
      Translation.StringTable.Add(ChildNodes[i].Attributes['id'],
                                  ChildNodes[i].ChildNodes[0].Text);  // CDATA
    end;
  end;
end;

procedure TLangSource.ParseTranslationInfo(Node : IXMLNode; const Translation : TTranslation);
  var
    TI : TTranslationInfo;
begin
  { TODO : парсинг информации о языковом переводе. }
  With Node.ChildNodes['TranslationInfo'], TI do
  begin
    Language  := ChildValues['Language'];
    Copyright := ChildValues['Copyright'];
    Comments  := ChildNodes['Comments'].ChildNodes[0].Text;  // CDATA
  end;
  Translation.Info := TI;
end;

procedure TLangSource.SaveToSource;
begin
{ TODO :
Запись данных в валидном формате языкового источника в XML-документ.
Записаны должны быть: вся коллекция переводов с сопутствующей информацией
и данные о формате языкового источника. }

  InitXML;
  FormatData; // формирование данных в XML-документе для последующей записи
  WriteData;  // Непосредственно запись XML-документа в источник
end;

///  Процедура выброса эксепшена типа ELangSourceNotValid:
procedure TLangSource.XML_Panic;
begin
  raise ELangSourceNotValid.Create(STR_INVALID_LANGSOURCE);
end;
{$ENDREGION}

{$REGION 'TLanguageFile'}
//-----------------------------{ TLanguageFile }--------------------------------

constructor TLanguageFile.Create(const FileName : String; AutoLoad : Boolean = True);
begin
  FFileName := FileName;
  Inherited Create(AutoLoad And FileExists(FileName));  // хитро, правда? :)
//  FXML.FileName := FileName;  // эти данные требуются уже в конструкторе, если AutoLoad = True, а FXML ещё не создан в InitXML *WALL*
  //LoadFromSource; // в конструкторе предка новый параметр AutoLoad
end;

function TLanguageFile.GetFileName : String;
begin
//  FXML.FileName := FFileName; // make sure the filename is correct, but Active??
  Result := FXML.FileName;
end;

procedure TLanguageFile.InitXML;
//  var
//    sFileNameBackup : String;
begin
{ TODO : переопределить метод забэкаплеивая файлнэйм }
//  // а если FXML ещё не создан, то мы потеряем FileName, переданный в конструктор
//  // данного класса, ведь присвоить свойству мы его не можем, т.к. объекта ещё нет
//  If Assigned(FXML) Then sFileNameBackup := FXML.FileName;
//  Inherited InitXML;
//  FXML.FileName := sFileNameBackup; // если FXML не был создан в момент вызова данной процедуры
//                                    // то это имя файла будет пустое
//  //Active := True;
  Inherited InitXML;
  FXML.FileName := FFileName;
end;

procedure TLanguageFile.LoadFromSource;
begin
  // Здесь может выскочить эксепшен, если имя файла было задано пустое, например,
  // в процедуре InitXML сбросилось.
  FXML.LoadFromFile;
  Parse;
end;

procedure TLanguageFile.WriteData;
  var
    L : TStringList;
    SS : TStringStream;
begin
  // Индусский код с целью добавления перевода строки после XML пролога:
  // но в других языковых источниках этого же не будет! нужно чтобы такое было
  // в классе-предке! =((((((((((((((
  L := TStringList.Create;
  SS := TStringStream.Create;
  Try
    FXML.SaveToStream(SS);
    SS.Position := 0;
    L.LoadFromStream(SS);
    If (L.Count > 0) Then L[0] := StringReplace(L[0], '?>', '?>'#13#10, []);
    L.SaveToFile(FXML.FileName);
  Finally
    FreeAndNil(L);
    FreeAndNil(SS);
  End;
//    FXML.SaveToFile;
end;
{$ENDREGION}

{$REGION 'TLanguageResource'}
//----------------------------{ TLanguageResource }-----------------------------

constructor TLanguageResource.Create(const FileName, ResourceID : String);
begin
  Inherited Create;
  FFileName := FileName;
  FResourceID := ResourceID;
  FMS := TMemoryStream.Create;
  LoadFromSource;
end;

destructor TLanguageResource.Destroy;
begin
  FreeAndNil(FMS);
  Inherited Destroy;
end;

procedure TLanguageResource.LoadFromSource;
begin
  FMS.Clear;
  { TODO : Загрузка XML-документа в поток FMS из ресурса FResourceID в файле FFileName. }
  FMS.Position := 0;
  FXML.LoadFromStream(FMS);
  Parse;
end;

procedure TLanguageResource.WriteData;
begin
  FMS.Position := 0;
  { TODO : Запись данных из потока в ресурс FResourceID в файле FFileName. }
end;
{$ENDREGION}

{$REGION 'TTranslator'}
//------------------------------{ TTranslator }---------------------------------

constructor TTranslator.Create(LangSource : TLangSource; OwnsSource : Boolean = True);
begin
  Inherited Create;
  If Not Assigned(LangSource) Then raise EArgumentException.Create(STR_INVALID_LANGSOURCE_ARG);
  FLangSource := LangSource;
  FOwnsSource := OwnsSource;
end;

destructor TTranslator.Destroy;
begin
  If FOwnsSource Then FreeAndNil(FLangSource);
  Inherited;
end;

function TTranslator.GetCurrentLanguage : String;
begin
  If Assigned(FCurrentTranslation) Then
    Result := FCurrentTranslation.Info.Language;
end;

function TTranslator.GetStringByID(const StringID : Integer) : String;
begin
  If Assigned(FCurrentTranslation) Then
    Result := FCurrentTranslation.GetStringByID(StringID);
end;

procedure TTranslator.SetCurrentLanguage(Value : String);
  var
    i : Integer;
begin
  Value := Trim(Value);
  With FLangSource.Translations do
  begin
    For i := 0 To Count - 1 do
    begin
      If AnsiSameText(Items[i].Info.Language, Value) Then
      begin
        FCurrentTranslation := Items[i];
        Exit;
      end;
    end;
    { TODO : Кинуть эксепшен о том, что ничего не найдено. }
  end;
end;

function TTranslator.TranslateProperty(const AObject : TObject;
                                       const Prop : TRTTIProperty;
                                       const Translation : TObjectTranslation;
                                       TranslateWithDict : Boolean) : String;
  var
    Val : TValue;
    i : Integer;
begin
  { TODO : Перевод единичного свойства. }
  Val := Prop.GetValue(AObject);
  If TranslateWithDict Then Val := TValue.From(TranslateWithDictionary(Val.AsString));
  //Else
  For i := 0 To Translation.Properties.Count - 1 do
  begin
    If AnsiSameText(Prop.Name, Translation.Properties.Items[i].PropertyName) Then
    begin
      Val := TValue.From(Translation.Properties.Items[i].PropertyTranslation);
      Break;
    end;
  end;
  Prop.SetValue(AObject, Val);
end;

procedure TTranslator.Translate(const AObject : TPersistent; const Translation : TObjectTranslation;
                                TranslateNestedRTTI : Boolean);
  var
    RTTIContext : TRTTIContext;
    Prop : TRTTIProperty;
    Val : TValue;
begin
  { TODO : Перевод всех свойств объекта AObject. }
  //TranslateProperty(TPropInfo, (Translation is TDictionaryTranslation))
  For Prop in RTTIContext.GetType(AObject.ClassType).GetProperties do
  begin
    // переводим только публичные свойства:
    If (Prop.Visibility = mvPublic) Or (Prop.Visibility = mvPublished) Then
    begin
      Val := Prop.GetValue(AObject);
      Case Val.Kind of
        tkString, tkLString, tkWString, tkUstring:
          TranslateProperty(AObject, Prop, Translation, (Translation is TDictionaryTranslation));
        tkClass:
          Translate(Val.AsObject as TPersistent, TDictionaryTranslation(Translation), TranslateNestedRTTI);
      End;
//      Val := TValue.From('ololo');
//      Prop.SetValue(Obj, Val);
    end;
  end;
end;

procedure TTranslator.Translate(const Component : TComponent; TranslateNestedRTTI : Boolean = True);
  var
    i : Integer;
begin
  { TODO : Перевод всех свойств объекта компонента Component. }
  For i := 0 To Component.ComponentCount - 1 do
    Translate(Component.Components[i], TranslateNestedRTTI);

  With FCurrentTranslation.Components do
  begin
    For i := 0 To Count - 1 do
    begin
      If AnsiSameText(Component.Name, Items[i].Name) Then
      begin
        // вызов основной процедуры перевода:
        Translate(Component, Items[i], TranslateNestedRTTI);
        Break;
      end;
    end;
  end;
end;

procedure TTranslator.Translate(const RTTIObject : TPersistent; const RTTIObjectID : Integer;
                                TranslateNestedRTTI : Boolean = False);
  var
    i : Integer;
begin
  { TODO : Перевод всех свойств RTTI-объекта. }
  With FCurrentTranslation.RTTIObjects do
  begin
    For i := 0 To Count - 1 do
    begin
      If (RTTIObjectID = Items[i].RTTIObjectID) Then
      begin
        // вызов основной процедуры перевода:
        Translate(RTTIObject, Items[i], TranslateNestedRTTI);
        Break;
      end;
    end;
  end;
end;

function TTranslator.TranslateWithDictionary(const OriginalText : String) : String;
  var
    i : Integer;
begin
  { TODO : Перевод строки OriginalText при помощи словаря. }
  With FCurrentTranslation.Dictionary do
  begin
    For i := 0 To Count - 1 do
    begin
      If AnsiSameText(OriginalText, Items[i].OriginalText) Then
      begin
        Result := Items[i].TranslatedText;
        Break;
      end;
    end;
  end;
end;
{$ENDREGION}

{$REGION 'TAutoAppTranslator'}
//---------------------------{ TAutoAppTranslator }-----------------------------

function TAutoAppTranslator.TranslateApp(const Language : String) : Boolean;
begin
  Result := False;

  If IsLibrary Then raise Exception.Create('Libraries not supported.');

  Try
    CurrentLanguage := Language;
    Translate(Application);
  Except
    Exit;
  End;
  Result := True;
end;

function TAutoAppTranslator.TranslateApp(const LocaleID : Cardinal) : Boolean;
  var
    L : TLanguages;
begin
  L := TLanguages.Create;
  Result := TranslateApp(L.NameFromLocaleID[LocaleID]);
  FreeAndNil(L);
end;

function TAutoAppTranslator.TranslateApp : Boolean;
begin
  Result := TranslateApp(GetUserDefaultLCID);
end;
{$ENDREGION}

end.
